Directorty Opus 5 - Magellan/Opus 5 - Magellan.iso/Archiv/ArcByName.lha/ArcByName.dopus5

Text File | 1995-09-27 | 6KB | 182 lines

/*    $VER: ArcByName for DOpus5 V1.0 (27.09.95) by Willy Gwerder

      This DOpus Arexx script will archive the selected source-entries to the
      current destination. The entries will have the same filename
      (+ .lha or .lzx) like the original files. The source-files can be deleted.

      You can use lha or lzx as archiver.
      LhA and LZX are expected to be in your c: directory

      IMPORTANT !!!! Call this program with arguments like this:

      ArcByName.Dopus5 lha {Qp}     or
      ArcByName.Dopus5 lzx {Qp}

      The argument {Qp} is needed to find the calling DOpus AREXX-port.
      If you don't give it, the progam will use DOPUS.1 !!  */

/*--------------------------------------------------------------------------*/


/*------------------- check arguments --------------------------------------*/

PARSE UPPER ARG cmd DOpusPort .
IF DOpusPort ='' THEN DOpusPort = DOPUS.1
ADDRESS VALUE DOpusPort
IF (cmd ~= "LHA")&(cmd ~= "LZX") THEN DO
   dopus request '"I need LHA or LZX as argument. See Docs!" ABORT'
   EXIT
END

/*------------------- define and reset variables ---------------------------*/

OutputWindow = '>CON:0/150/640/40/'cmd'_Output/INACTIVE/CLOSE/SCREEN'DOpusPort''
OPTIONS results
OPTIONS failat 50
pass = 0
del = 0
oldcd = PRAGMA(D)

/*------------------- ask about windows and dirs ---------------------------*/

lister query source
Sourcelister = result
lister clear Sourcelister abort

lister query dest
Destlister = result

SELECT
   WHEN Sourcelister = "RESULT" THEN DO
      dopus request '"I need a source!" ABORT'
      EXIT
   END
   WHEN Destlister = "RESULT" THEN DO
      dopus request '"I need a destination!" ABORT'
      EXIT
   END
   WHEN WORDS(Sourcelister) >1 | WORDS(Destlister) >1 THEN DO
      dopus request '"This script cannot be used with multiple Source/Destlisters" ABORT'
      EXIT
   END
   OTHERWISE DO
      lister set Sourcelister busy on
      lister set Destlister busy on
   END
END

lister query Sourcelister path
SourceDir = result
PRAGMA(D,SourceDir)
lister query Destlister path
DestDir = result

/*------ ask user if he wants the source files to be deleted ----------------*/

DO FOREVER
   dopus request '"Delete source-files after archiving?" yes|no'
   del = RC
      IF del = 1 THEN dopus request '"Are you sure???" yes|no'
      ELSE break
   sure = RC
   IF sure = 1 THEN break
END

/*---------------------- get number of selected files ------------------------*/

lister query Sourcelister numselentries
TotFiles = result

IF TotFiles = 0 THEN DO
   dopus request '"There is nothing to archive!" ABORT'
   call cleanup
END
RemFiles = TotFiles

/*---------------------- archive selected files ------------------------------*/

lister set Sourcelister progress TotFiles 'Archiving...'

DO WHILE RemFiles > 0
   lister query Sourcelister firstsel
   CurrentFile = result
   CurrentFile = delstr(CurrentFile,1,1)                    /* strip  */
   CurrentFile = delstr(CurrentFile,Length(CurrentFile),1)  /* quotation marks */
   IF UPPER(RIGHT(CurrentFile,5)) = ".INFO" | UPPER(RIGHT(CurrentFile,4)) = ".LHA" |,
      UPPER(RIGHT(CurrentFile,4)) = ".LZX" THEN DO
      lister select Sourcelister '"'CurrentFile'" off'
      lister refresh Sourcelister
      RemFiles = RemFiles -1
      ITERATE
   END
   lister set Sourcelister progress count TotFiles-RemFiles+1
   lister set Sourcelister progress name '"'CurrentFile'"'
   pass = pass +1

   ADDRESS command

   IF cmd = LHA THEN,
   'LhA -rey a "'DestDir''CurrentFile'.lha" "'CurrentFile'" "'CurrentFile'.info" 'OutputWindow''
   ELSE,
   'LZX -r -e -3 a "'DestDir''CurrentFile'.lzx" "'CurrentFile'" "'CurrentFile'.info" 'OutputWindow''

   /*--------------------- check for CTRL-C or error -------------------------*/

   IF RC > 9 THEN DO
      address Value DOpusPort
      IF EXISTS(''DestDir''CurrentFile'.'cmd'') THEN command Delete '"'DestDir''CurrentFile'.'cmd'"'
      CALL CLEANUP
   END

   /*--------------------- update listers ------------------------------------*/

   ADDRESS VALUE DOpusPort

   lister add Destlister '"'CurrentFile'.'cmd'" 'pass' -1 0 RWED ArcByName_Temp_Entry'
   IF DestDir = SourceDir & del = 1 THEN DO
      lister remove Destlister '"'CurrentFile'"'
      lister remove Destlister '"'CurrentFile'.info"'
   END
   lister refresh Destlister

   IF DestDir = SourceDir THEN lister add Sourcelister '"'CurrentFile'.'cmd'" 'pass' -1 0 RWED ArcByName_Temp_Entry'

   IF del ~= 1 THEN DO
      lister select Sourcelister '"'CurrentFile'" off'
      lister select Sourcelister '"'CurrentFile'.info" off'
   END
   ELSE DO
      ADDRESS command
      delete '"'SourceDir''CurrentFile'" all'
      delete '"'SourceDir''CurrentFile'.info"'
      ADDRESS VALUE DOpusPort
      lister remove Sourcelister '"'CurrentFile'"'
      lister remove Sourcelister '"'CurrentFile'.info"'
   END
   lister refresh Sourcelister

   /*--------------------- check for user abort ------------------------------*/

   lister query Sourcelister abort
   aborted = result
   if aborted = 1 THEN CALL CLEANUP

   /*--------------------- are there any files left? -------------------------*/

   lister query Sourcelister numselentries
   RemFiles = result
END

/*------------------------ rescan windows and exit ---------------------------*/

CLEANUP:

lister clear Sourcelister progress
lister set Sourcelister busy off
lister set Destlister busy off
lister read Destlister DestDir force
lister wait Destlister
IF SourceDir = DestDir THEN lister copy Destlister Sourcelister
PRAGMA(D,oldcd)
EXIT